module DB where
import IO
import Char
import Data.List
import Data.Maybe
import Text.ParserCombinators.Parsec

type Formula = String

data CellType  = 	Empty | 
			CellNumber Float | 
			CellString String |
			CellFormula Formula Float
			deriving (Read, Show, Eq)

-- PREZENTACJA TYPU CELL JAKO ZAWARTOSCI KOMOREK W POSTACI STRINA
getVal :: CellType -> String
getVal (Empty) = ""
getVal (CellNumber  a) = show a
getVal (CellString  a) = a
getVal (CellFormula a b) = show a


--PREZENTACJA TYPU CELL JAKO JUZ ROZSZYTYCH WARTOSCI W POSTACI STRINGA
getEvaluatedVal :: CellType -> [[CellType]] -> String
getEvaluatedVal (Empty) tab = ""
getEvaluatedVal (CellNumber  a) tab = show a
getEvaluatedVal (CellString  a) tab = a
getEvaluatedVal (CellFormula a b) tab = show ( evaluate (CellFormula a b) tab 0.0 ) 


--OBLICZANIE WARTOSCI LICZBOWEJ KOMORKI
evaluate :: CellType -> [[CellType]] -> Float -> Float
evaluate (CellNumber a) tab emptyVal = a
evaluate (CellString a) tab emptyVal = 0.0
evaluate Empty tab emptyVal = emptyVal
evaluate (CellFormula formula b) tab emptyVal |  (isSum formula)  = evaluateFormulaSum formula tab
                                              |  (isProduction formula) = evaluateFormulaProduction formula tab
                                              |  (isAverage formula) = evaluateFormulaAverage formula tab        
 	                         	      |  otherwise = (error "Bledna formula")



--FUNKCJE SPRWADZAJA RODZAJ FORMULY
isSum :: Formula -> Bool
isSum formula = checkPrefix formula "=SUMA"

isProduction :: Formula -> Bool
isProduction formula = checkPrefix formula "=ILOCZYN"

isAverage :: Formula -> Bool
isAverage formula = checkPrefix formula "=SREDNIA"

isFormula :: Formula -> Bool
isFormula formula = (isSum formula) || (isAverage formula) || (isProduction formula)

isRange :: Formula -> Bool
isRange formula = length (split (cutFormula formula) ':') > 1



--FUNKCJE DO OBLICZANIA FORMULY SUMY, ILOCZYNU, SREDNIEJ
evaluateFormulaSum formula tab  | (isRange formula) = sum (evaluateTableRange min_row min_col max_row max_col tab 0.0) --suma z zkaresem
                                | otherwise = sum (evaluateTableCells list tab 0.0) --suma z lista komorek
                 where list = getTupleList formula
		       range = getRange formula
		       min_row = getTupleFirst  (range !! 0)
                       min_col = getTupleSecond (range !! 0)
		       max_row = getTupleFirst  (range !! 1)
                       max_col = getTupleSecond (range !! 1)


 
evaluateFormulaProduction formula tab  | (isRange formula) = product (evaluateTableRange min_row min_col max_row max_col tab 1.0) --iloczyn z zkaresem
                                       | otherwise = sum (evaluateTableCells list tab 1.0) --suma z lista komorek
                 where list = getTupleList formula
		       range = getRange formula
		       min_row = getTupleFirst  (range !! 0)
                       min_col = getTupleSecond (range !! 0)
		       max_row = getTupleFirst  (range !! 1)
                       max_col = getTupleSecond (range !! 1)


evaluateFormulaAverage formula tab  | (isRange formula) && (evaluatedRangeCount > 0) =  (sum (evaluatedRange)) / evaluatedRangeCount --srednia z zakresem
                                    | (evaluatedListCount > 0) =  (sum  (evaluatedList) ) / evaluatedListCount --suma z zakresem
                                    | otherwise =  error "Niepoprawny format lub zakres funkcji"
                 where evaluatedRange = evaluateTableRange min_row min_col max_row max_col tab 0.0
                       evaluatedRangeCount = getLength (evaluatedRange)
		       evaluatedList = evaluateTableCells list tab 0.0
		       evaluatedListCount = getLength (evaluatedList)
                       list = getTupleList formula
		       range = getRange formula
		       min_row = getTupleFirst  (range !! 0)
                       min_col = getTupleSecond (range !! 0)
		       max_row = getTupleFirst  (range !! 1)
                       max_col = getTupleSecond (range !! 1)


--funkcja wybiera z liste list obiektow CellType komorku o wybranym zakresie ( parametry min_row ... ) zamienia je na plaska liste , rozszywa wartosci
evaluateTableRange min_row min_col max_row max_col tab emptyVal =  evaluateRow ( flatten ( transpose ( take (max_col- min_col + 1 ) (drop min_col ( transpose ( take (max_row- min_row + 1) ( drop min_row tab ) ) ) ) ) ) )  tab  emptyVal

--roszwywa liste obiektow typu CellType na liste floatow
evaluateRow [] tab emptyVal = []
evaluateRow (x:xs) tab emptyVal = evaluate x tab emptyVal : evaluateRow xs tab emptyVal


--roszwywa liste indeksow (krotek) okreslajacych polozenie na liste na liste floatow
evaluateTableCells [] tab emptyVal = [] 
evaluateTableCells (x:xs) tab emptyVal =  evaluateTableCell row col tab emptyVal : evaluateTableCells xs tab emptyVal 
			where row = getTupleFirst x
                              col = getTupleSecond x

--rozszywa pojedyncza krotke o pozoleniu row col w tabeli tab
evaluateTableCell row col tab emptyVal = evaluate ((flatten ( take 1 ( drop col ( transpose ( take 1 ( drop row tab ) ) ) ) ) ) !! 0)  tab emptyVal




--ZACZYTYWANIE IDENTYFIKATOROW FORMUL i MAPOWANIE ICH NA ZAKRESY, LISTE INDEKSOW(KROTEK) 

getRange rangeExpr = getProperRange ( (split ( cutFormula rangeExpr ) ':') )
getTupleList rangeExpr = toIntTuples ( (split ( cutFormula rangeExpr ) ';') )

alphabet = ['A'..'C']

getRowCoordinates [] = []
getRowCoordinates (x:xs) =  (getSecondCoordinate x) : getRowCoordinates xs

getColCoordinates [] = []
getColCoordinates (x:xs) =  (getFirstCoordinate x) : getColCoordinates xs



getFirstCoordinate a = fromJust (elemIndex (((take 1 a)) !! 0) alphabet)
getSecondCoordinate a = digitToInt ((take 1 (drop 1 a) ) !!0 )-1 


toIntTuples [] = []
toIntTuples (x:xs) = toIntTuple x : toIntTuples xs


-- Transformuje "A1" --> "("0","0")", "B2" --> "B1"
toIntTuple addressStr = ( (getSecondCoordinate addressStr), (getFirstCoordinate addressStr) )


-- ["A5","F1","D3"] -> [("A",1),("F",5)]
getProperRange xs | ((min_x_cor == max_x_cor) && (min_y_cor == max_y_cor )) =  [(min_x_cor,min_y_cor)]
                  | otherwise =                                                 [(min_x_cor,min_y_cor),(max_x_cor,max_y_cor)]
		where x_cor = getRowCoordinates xs
		      y_cor = getColCoordinates xs	   		
                      min_x_cor = minimum x_cor
                      max_x_cor = maximum x_cor 
                      min_y_cor = minimum y_cor
                      max_y_cor = maximum y_cor


--DODAWANIE WIERSZY I KOLUMN-----------------------------------------------------------------
--dodaje kolumne na wskazanym miejscu i przesuwa pozostale dane w prawo
addColumn :: [[CellType]] -> String -> [[CellType]]
addColumn [] _ = newTable Empty 1 1
addColumn a pos = addCol a (findColNumber pos)

--dodaje wiersz we wskazanym miejscy - przesuwa pozostałe dane w dol
addRow :: [[CellType]] -> Int -> [[CellType]]
addRow [] _ = newTable Empty 1 1
addRow a pos = addR a pos (length (head a))

addR :: [[CellType]] ->Int -> Int -> [[CellType]]
addR [] 0 size = [createRow size]
addR [] _ _ = []
addR (x:xs) 0 size = (createRow size):x:xs
addR (x:xs) pos size = x:(addR xs (pos-1) size)

createRow 0 = []
createRow i = (Empty):(createRow (i-1))

addCol :: [[CellType]] -> Int -> [[CellType]]
addCol [] 0 = []
addCol [] _ = []
addCol (x:xs) pos = (addCellInRow x pos):(addCol xs pos)

addCellInRow [] 0 = [Empty]
addCellInRow [] _ = []
addCellInRow (x:xs) 0 = (Empty):x:xs
addCellInRow (x:xs) pos = x:(addCellInRow xs (pos-1))



--USUWANIE WIERSZY I KOLUMN----------------------------------------------------------------
delRow :: [[CellType]] -> Int -> [[CellType]]
delRow [] _ = []
delRow (x:xs) 0 = xs
delRow (x:xs) pos = x:(delRow xs (pos-1))

delColumn a pos = delCol a (findColNumber pos)

delCol :: [[CellType]] -> Int -> [[CellType]]
delCol [] _ = []
delCol (x:xs) pos = clearTable ( (delCellFromRow x pos):(delCol xs pos) )

clearTable [] = []
clearTable (x:xs) 
		| x==[]		= xs
		| otherwise	= x:xs


delCellFromRow [] _ = []
delCellFromRow (x:xs) 0 = xs
delCellFromRow (x:xs) pos = x:(delCellFromRow xs (pos-1))



--Tworzenie nowego wiersza i tabeli-----------------------------------------------------
newRow _ 0 = [] 
newRow value row = value : (newRow value (row-1) )

newTable _ 0 _ = []
newTable value rowsSize colsSize = ( newRow value colsSize ) : ( newTable value (rowsSize - 1) colsSize )

--Ustawianie zadanej wartosci wiersza i tabeli
setRowValue (x:xs) value 0   = value : xs
setRowValue (x:xs) value col = x : setRowValue xs value (col - 1) 

setTableValue (x:xs) value 0 col   =  (setRowValue x value col) : xs
setTableValue (x:xs) value row col =  x : (setTableValue xs value (row - 1) col)

findColNumber :: String -> Int
findColNumber a = (ord (toLower(head a)))-97


--odzyskanie przechowywanej wartości w komórce-------------------------------------------------------------
getRowValue [] _ = Empty
getRowValue (x:xs) 0 = x
getRowValue (x:xs) col = getRowValue xs (col-1)

getTableValue [] _ _ =  getRowValue [] 0
getTableValue (x:xs) 0 col = getRowValue x col
getTableValue (x:xs) row col = getTableValue xs (row-1) col


--WYPISYWANIE PELNEJ WARTOSCI KOMORKI---------------------------------------------------------------------
--przyjmuje tablicę, pozycję typu "B2" a następnie zwraca stringa z wartością wybranej komórki
showSingle :: [[CellType]] -> Int->Int-> String
showSingle a col row = getVal (getTableValue a row col)


--WYPISYWANIE TABLICY Z FORMULAMI---------------------------------------------------------------------------------------
--zwraca gotowego stringa z arkusza - trzeba wrzucić to tylko w putStrLn :)
showTable :: [[CellType]] -> String
showTable [] = "Arkusz jest pusty\n"
showTable a = (showCol 65 (length (head a))) ++ "\n" ++ (showTab a 1)

--zwraca linię z literowymi oznaczeniami kolumn w ilości i znaków (początkowo dajemy a=65 -> 'A')
showCol :: Int -> Int -> String
showCol a 0 = ""
showCol a i = "\t" ++ [chr a] ++ (showCol (a+1) (i-1))

showTab :: [[CellType]] -> Int -> String
showTab [] i =  {-(show i) ++-} ""
showTab (a:as) i = (show i) ++ "\t" ++ (showRow a)++"\n"++(showTab as (i+1))

showRow :: [CellType] -> String
showRow [] = ""
showRow (a:as) = (showCell a)++"\t"++(showRow as)

showCell :: CellType -> String
--showCell a = take 7(getVal a)
showCell a = case (length (getVal a)) > 7 of
		True	-> (take 5 (getVal a)) ++ ".."
		False	-> take 7 (getVal a)



--WYPISYWANIE TABLICY Z OBLICZONYMI FORMULAMI---------------------------------------------------------------------------------------
--zwraca gotowego stringa z arkusza - trzeba wrzucić to tylko w putStrLn :)
showEvaluatedTable :: [[CellType]] -> String
showEvaluatedTable [] = "Arkusz jest pusty\n"
showEvaluatedTable a = (showEvaluatedCol 65 (length (head a)) a) ++ "\n" ++ (showEvaluatedTab a 1 a)

--zwraca linię z literowymi oznaczeniami kolumn w ilości i znaków (początkowo dajemy a=65 -> 'A')
showEvaluatedCol :: Int -> Int -> [[CellType]] -> String
showEvaluatedCol a 0 spreadsheet = ""
showEvaluatedCol a i spreadsheet = "\t" ++ [chr a] ++ (showEvaluatedCol (a+1) (i-1) spreadsheet)

showEvaluatedTab :: [[CellType]] -> Int -> [[CellType]] -> String
showEvaluatedTab [] i spreadsheet =  {-(show i) ++-} ""
showEvaluatedTab (a:as) i spreadsheet = (show i) ++ "\t" ++ (showEvaluatedRow a spreadsheet)++"\n"++(showEvaluatedTab as (i+1) spreadsheet)

showEvaluatedRow :: [CellType] ->  [[CellType]]  -> String
showEvaluatedRow [] spreadsheet = ""
showEvaluatedRow (a:as) spreadsheet = (showEvaluatedCell a spreadsheet)++"\t"++(showEvaluatedRow as spreadsheet)

showEvaluatedCell :: CellType -> [[CellType]] -> String
showEvaluatedCell a spreadsheet = case (length (getVal a)) > 7 of
		True	-> (take 5 (getEvaluatedVal a spreadsheet) ) ++ ".."
		False	-> take 7 (getEvaluatedVal a spreadsheet) 


--PARSOWANIE PLIKU CSV----------------------------------------------------------------------------------------------
--plik csv zawiera 0 badz wiecej linii, ktore koncza sie znakiem konca linii 'eol'
csvFile :: GenParser Char st [[String]]
csvFile = 
    do result <- many line
       eof
       return result

--kazdy wiersz zawiera jedna badz wiecej komorek oddzielonych srednikami
line :: GenParser Char st [String]
line = 
    do result <- cells
       eol
       return result
       
-- buduje liste komorek.  parsuje pierwsza komorke, a potem zajmuje sie reszta
cells :: GenParser Char st [String]
cells = 
    do first <- cellContent
       next <- remainingCells
       return (first : next)

-- komorka moze konczyc sie srednikiem, co oznacza, ze oczekujemy kolejnej/kolejnych komorek w wierszu,
-- natomiast jesli srednikiem sie nie konczy, oznacza to, ze jestesmy na koncu linii
remainingCells :: GenParser Char st [String]
remainingCells =
    (char ';' >> cells)
    <|> (return [])

-- kazda komorka zawiera 0 lub wiecej znakow, ktore nie moga byc srednikiem ani koncem linii
cellContent :: GenParser Char st String
cellContent = 
    many (noneOf ";\n")
       

-- znakiem konca linii jest \n
eol :: GenParser Char st Char
eol = char '\n'

--PARSUJE STRINGA W FORMACIE CSV DO [[String]]
parseCSV :: String -> Either ParseError [[String]]
parseCSV input = parse csvFile "(unknown)" input



--ZAPISYWANIE DANYCH-----------------------------------------------------------------------------------------------
--zapisuje do pliku 'fname' dane 'a'
saveToFile a = do
			putStrLn "Podaj nazwe pliku: "
			fname <- getLine
			handle <- openFile fname WriteMode
			hPutStrLn handle (saveTable a)
			putStrLn "\n--Zapisano.\n"
			hClose handle

--przeksztalca tablice danych do Stringa
--saveTable :: [[CellType]] -> String
saveTable [] = ""
saveTable [x] = saveRow x
saveTable (x:xs) = (saveRow x) ++ "\n" ++ (saveTable xs)

--przeksztalca wiersz danych do stringa
--saveRow :: [CellType] -> String
saveRow [] = ""
saveRow [x] = saveCell x
saveRow (x:xs) = (saveCell x) ++ ";" ++ (saveRow xs)

--przekształca zawartosc komorki do stringa
--saveCell :: CellType -> String
saveCell x = show x


--WYCIĄGANIE TABELI DANYCH PO PARSOWANIU PLIKU-------------------------------------------------------------------
getCSVData (Right b) = b

readTable :: [[String]] -> [[CellType]]
readTable [] = []
readTable [a] = [readRow a]
readTable (a:as) = (readRow a) : (readTable as)

readRow :: [String] -> [CellType]
readRow [] = []
readRow [a] = [readCell a]
readRow (a:as) = (readCell a):(readRow as)

readCell a = read a :: CellType

--zwraca tabele [[CellType]] utworzona z wczytanego pliku
getData :: String -> [[CellType]]
getData a = readTable(getCSVData (parseCSV a))
-----------------------------------------------------------------------------------------------------------------


                                    
--------------------------------------------------------
--FUNKCJE O CHARAKTERZE POMOCNICZYM
-------------------------------------------------------

--sprawdz czy formula zaczyna sie od prefixu
checkPrefix formula prefix =
    if restIsJust
      then True
      else False
  where
    (restIsJust, restOfString) =
        case stripPrefix prefix formula of
            Just something -> (True, something)
            Nothing -> (False, undefined)


--wytjnij stringi z wyrazenia                           
cutStrings rangeExpr [] = rangeExpr
cutStrings rangeExpr (x:xs) = cutStrings (cutFromString rangeExpr x) xs
cutFromString s find =
    if take (length find) s == find
        then  (cutFromString (drop (length find) s) find )
        else [head s] ++ (cutFromString (tail s) find )


--splasz liste list do listy
flatten :: [[a]] -> [a]
flatten [] = []
flatten [[]] = []
flatten ([]:ys) = flatten ys
flatten ((x:xs):ys) = x : (flatten (xs:ys))

getTupleFirst (x,y) = x
getTupleSecond (x,y) = y

getLength [] = 0
getLength (x:xs) = 1 + getLength xs

--podziel string wedlug separatora
split :: String -> Char -> [String]
split [] delim = [""]
split (c:cs) delim
   | c == delim = "" : rest
   | otherwise = (c : head rest) : tail rest
   where
       rest = split cs delim



sortTuple (a,b) | a <= b  =  (a, b)
                | otherwise = (b, a)

cutFormula rangeExpr = cutStrings rangeExpr ["=SUMA", "=ILOCZYN", "=SREDNIA", ")", "("]

--wytnij string z wyrazenia
--cutFromString :: Eq a => [a] -> [a] -> [a]
--cutFromString [] _  = []
--------------------------------------------------------------------------------------------------
